home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 7 / Amiga Format AFCD07 (Dec 1996, Issue 91).iso / serious / shareware / programming / emacs-complete / fsf / emacs / lisp / easymenu.el < prev    next >
Lisp/Scheme  |  1994-08-13  |  5KB  |  128 lines
  1. ;;; easymenu.el --- support the easymenu interface for defining a menu.
  2.  
  3. ;; Copyright (C) 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Keywords: emulations
  6. ;; Author: rms
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; This is compatible with easymenu.el by Per Abrahamsen
  25. ;;; but it is much simpler as it doesn't try to support other Emacs versions.
  26. ;;; The code was mostly derived from lmenu.el.
  27.  
  28. ;;; Code:
  29.  
  30. ;;;###autoload
  31. (defmacro easy-menu-define (symbol maps doc menu)
  32.   "Define a menu bar submenu in maps MAPS, according to MENU.
  33. The arguments SYMBOL and DOC are ignored; they are present for
  34. compatibility only.  SYMBOL is not evaluated.  In other Emacs versions
  35. these arguments may be used as a variable to hold the menu data, and a
  36. doc string for that variable.
  37.  
  38. The first element of MENU must be a string.  It is the menu bar item name.
  39. The rest of the elements are menu items.
  40.  
  41. A menu item is usually a vector of three elements:  [NAME CALLBACK ENABLE]
  42.  
  43. NAME is a string--the menu item name.
  44.  
  45. CALLBACK is a command to run when the item is chosen,
  46. or a list to evaluate when the item is chosen.
  47.  
  48. ENABLE is an expression; the item is enabled for selection
  49. whenever this expression's value is non-nil.
  50.  
  51. A menu item can be a string.  Then that string appears in the menu as
  52. unselectable text.  A string consisting solely of hyphens is displayed
  53. as a solid horizontal line.
  54.  
  55. A menu item can be a list.  It is treated as a submenu.
  56. The first element should be the submenu name.  That's used as the
  57. menu item in the top-level menu.  The cdr of the submenu list
  58. is a list of menu items, as above."
  59.   (` (let* ((maps (, maps))
  60.         (menu (, menu))
  61.         (keymap (easy-menu-create-keymaps (car menu) (cdr menu))))
  62.        (and (keymapp maps) (setq maps (list maps)))
  63.        (while maps
  64.      (define-key (car maps) (vector 'menu-bar (intern (car menu)))
  65.        (cons (car menu) keymap))
  66.      (setq maps (cdr maps))))))
  67.  
  68. (defvar easy-menu-item-count 0)
  69.  
  70. ;; Return a menu keymap corresponding to a Lucid-style menu list
  71. ;; MENU-ITEMS, and with name MENU-NAME.
  72. (defun easy-menu-create-keymaps (menu-name menu-items)
  73.   (let ((menu (make-sparse-keymap menu-name)))
  74.     ;; Process items in reverse order,
  75.     ;; since the define-key loop reverses them again.
  76.     (setq menu-items (reverse menu-items))
  77.     (while menu-items
  78.       (let* ((item (car menu-items))
  79.          (callback (if (vectorp item) (aref item 1)))
  80.          command enabler name)
  81.     (cond ((stringp item)
  82.            (setq command nil)
  83.            (setq name (if (string-match "^-+$" item) "" item)))
  84.           ((consp item)
  85.            (setq command (easy-menu-create-keymaps (car item) (cdr item)))
  86.            (setq name (car item)))
  87.           ((vectorp item)
  88.            (setq command (make-symbol (format "menu-function-%d"
  89.                           easy-menu-item-count)))
  90.            (setq easy-menu-item-count (1+ easy-menu-item-count))
  91.            (put command 'menu-enable (aref item 2))
  92.            (setq name (aref item 0))           
  93.            (if (keymapp callback)
  94.            (setq name (concat name " ...")))
  95.            (if (symbolp callback)
  96.            (fset command callback)
  97.          (fset command (list 'lambda () '(interactive) callback)))))
  98.     (if (null command)
  99.         ;; Handle inactive strings specially--allow any number
  100.         ;; of identical ones.
  101.         (setcdr menu (cons (list nil name) (cdr menu)))
  102.       (if name 
  103.           (define-key menu (vector (intern name)) (cons name command)))))
  104.       (setq menu-items (cdr menu-items)))
  105.     menu))
  106.  
  107. (defun easy-menu-change (path name items)
  108.   "Change menu found at PATH as item NAME to contain ITEMS.
  109. PATH is a list of strings for locating the menu containing NAME in the
  110. menu bar.  ITEMS is a list of menu items, as in `easy-menu-define'.
  111. These items entirely replace the previous items in that map.
  112.  
  113. Call this from `activate-menubar-hook' to implement dynamic menus."
  114.   (let ((map (key-binding (apply 'vector
  115.                  'menu-bar
  116.                  (mapcar 'intern (append path (list name)))))))
  117.     (if (keymapp map)
  118.     (setcdr map (cdr (easy-menu-create-keymaps name items)))
  119.       (error "Malformed menu in `easy-menu-change'"))))
  120.  
  121. (defmacro easy-menu-remove (menu))
  122.  
  123. (defmacro easy-menu-add (menu &optional map))
  124.  
  125. (provide 'easymenu)
  126.  
  127. ;;; easymenu.el ends here
  128.